home *** CD-ROM | disk | FTP | other *** search
/ Enigma Amiga Life 109 / EnigmaAmiga109CD.iso / dalla rivista / amiga.free / sorgenti vari / wolfedit2 2.0.4 source.sit / WolfEdit2 2.0.4 Source / UMap.p < prev    next >
Text File  |  1996-09-29  |  7KB  |  300 lines
  1. unit UMap;
  2.  
  3. interface
  4.     uses
  5.         UWolfDoc;
  6.  
  7. implementation
  8.     uses
  9.         UCreateLevel;
  10.  
  11.     const
  12.  
  13.         noStartPosAlrtID = 130;
  14.  
  15.     procedure TMap.IMap (itsMapList: TMapListDoc; itsLevelNumber: integer);
  16.         var
  17.             row, col: integer;
  18.             bounds: Rect;
  19.             cell: Point;
  20.             init: MapCell;
  21.             pt: Point;
  22.             cells: TMapCells;
  23.     begin
  24.         IEvtHandler(itsMapList);
  25.         fMapList := itsMapList;
  26.         fLevelNumber := itsLevelNumber;
  27.         fChanged := false;
  28.         fView := nil;
  29.         SetRect(bounds, 0, 0, 64, 64);
  30.         SetPt(fStartPos, 0, 0);
  31.         fStartPosSet := false;
  32.         new(cells);
  33.         cells.IMapCells(bounds);
  34.         fCells := cells;
  35.         ClearCell(init);
  36.         InsertWallOrDoor(init, $81);
  37.         for row := 0 to 63 do begin
  38.                 cell.v := row;
  39.                 for col := 0 to 63 do begin
  40.                         cell.h := col;
  41.                         fCells.SetCell(cell, init);
  42.                     end;
  43.             end;
  44. {$IFC FALSE}
  45.         ClearCell(init);
  46.         init.obj := $6C;
  47.         SetRowCol(63, 61, init);
  48.         ClearCell(init);
  49.         init.wall := $81;
  50.         init.obj := $62;
  51.         SetRowCol(63, 62, init);
  52.         ClearCell(init);
  53.         init.obj := $32;
  54.         SetRowCol(63, 63, init);
  55. {$ELSEC}
  56.         ClearCell(init);
  57.         init.obj := $14; {Start}
  58.         SetPt(pt, 1, 1);
  59.         SetCell(pt, init);
  60.  
  61.         ClearCell(init);
  62.         init.wall := $81;
  63.         init.obj := $62; {Secret Door}
  64.         init.dir := 3;
  65.         SetRowCol(1, 2, init);
  66.  
  67.         ClearCell(init);
  68.         SetRowCol(1, 3, init);
  69.  
  70.         ClearCell(init);
  71.         init.obj := $6C; {Brown Guard}
  72.         SetRowCol(2, 3, init);
  73.  
  74.         ClearCell(init);
  75.         init.obj := $32; {Treasure}
  76.         SetRowCol(2, 4, init);
  77. {$ENDC}
  78.     end;
  79.  
  80.     procedure TMap.Free;
  81.     begin
  82.         if fView <> nil then
  83.             fView.fFrame.fWindow.Free;
  84.         if fMapList <> nil then
  85.             fMapList.fIndex^^[fLevelNumber].map := nil;
  86.         if fCells <> nil then
  87.             fCells.Free;
  88.         inherited Free;
  89.     end;
  90.  
  91.     procedure TMap.Close;
  92.     begin
  93.         fMapList.CloseLevel(fLevelNumber);
  94.     end;
  95.  
  96.     procedure TMap.SetupMenus;
  97.     begin
  98.         EnableCmd(closeCmd);
  99.         inherited SetupMenus;
  100.     end;
  101.  
  102.     procedure TMap.LoadFromResource (h: LevelHandle);
  103.         var
  104.             row, col, x, y, i: integer;
  105.             p: longint;
  106.             e: ObjectEntry;
  107.             b: BSPEntry;
  108.             empty: MapCell;
  109.             map: MapCellGrid;
  110.  
  111.         procedure PokeItem (item: integer; var code: MapCell);
  112.         begin
  113.             code := empty;
  114.             if BAND(item, $80) <> 0 then
  115.                 InsertWallOrDoor(code, item);
  116.         end;
  117.  
  118.         procedure PokeObject (var e: ObjectEntry; var code: MapCell);
  119.             var
  120.                 room: integer;
  121.         begin
  122.             if e.code = $FF then begin
  123.                     room := h^^.map[e.y, e.x];
  124.                     code.area := h^^.zones[room] + 1;
  125.                 end
  126.             else if BAND(e.code, $F0) = $E0 then
  127.                 code.missingQuarters := BAND(e.code, $F)
  128.             else begin
  129.                     InsertObject(code, e.code);
  130.                     if (e.code >= $13) & (e.code <= $16) then begin
  131.                             SetPt(fStartPos, e.x, e.y);
  132.                             fStartPosSet := true;
  133.                         end;
  134.                     if e.code = $62 then
  135.                         InsertObjectExtra(code, e.code2);
  136.                 end;
  137.             if IsDoor(code) then
  138.                 code.noDoorSide := true;
  139.         end;
  140.  
  141.         procedure CheckSecretDoor (row, col, dir: integer);
  142.             var
  143.                 code: MapCell;
  144.         begin
  145.             if (row >= 0) & (col >= 0) then begin
  146.                     code := map[row, col];
  147.                     if IsSecretDoor(code) then
  148.                         map[row, col].dir := dir;
  149.                 end;
  150.         end;
  151.  
  152.         procedure CheckSpecial (row, col, grid, dir: integer);
  153.             var
  154.                 code: MapCell;
  155.         begin
  156.             if (row >= 0) & (col >= 0) then begin
  157.                     code := map[row, col];
  158.                     if IsDoor(code) then begin
  159.                             if grid >= $81 then begin
  160.                                     code.flushDoor := true;
  161.                                     code.dir := dir;
  162.                                 end
  163.                             else if grid = $80 then
  164.                                 code.noDoorSide := false;
  165.                         end;
  166.                     map[row, col] := code;
  167.                 end;
  168.         end;
  169.  
  170.     begin
  171.         ClearCell(empty);
  172.         for row := 0 to 63 do
  173.             for col := 0 to 63 do
  174.                 PokeItem(h^^.map[row, col], map[row, col]);
  175.         p := 0;
  176.         while GetObject(h, p, e) do
  177.             PokeObject(e, map[e.y, e.x]);
  178.         for i := 0 to BigEndian(h^^.numBSPEntries) - 1 do begin
  179.                 GetBSPEntry(h, i, b);
  180.                 if ((BAND(b.flags, bspTerminal) <> 0) & not odd(b.coord0)) then begin
  181.                         y := b.coord0 div 2;
  182.                         x := b.coord1 div 2;
  183.                         case BAND(b.flags, bspSegType) of
  184.                             bspFaceNorth:  begin
  185.                                     CheckSecretDoor(y, x, sdSouth);
  186.                                     CheckSpecial(y - 1, x, b.grid, sdSouth);
  187.                                 end;
  188.                             bspFaceSouth:  begin
  189.                                     CheckSecretDoor(y - 1, x, sdNorth);
  190.                                     CheckSpecial(y, x, b.grid, sdNorth);
  191.                                 end;
  192.                             bspFaceEast:  begin
  193.                                     CheckSecretDoor(x, y - 1, sdWest);
  194.                                     CheckSpecial(x, y, b.grid, sdWest);
  195.                                 end;
  196.                             bspFaceWest:  begin
  197.                                     CheckSecretDoor(x, y, sdEast);
  198.                                     CheckSpecial(x, y - 1, b.grid, sdEast);
  199.                                 end;
  200.                         end;
  201.                     end;
  202.             end;
  203.         fCells.CopyFromGrid(map);
  204.     end;
  205.  
  206.     function TMap.CreateResource (var h: LevelHandle; name: string): OSErr;
  207.     begin
  208.         if not fStartPosSet then begin
  209.                 ParamText(name, '', '', '');
  210.                 if Ask(noStartPosAlrtID) = cancel then begin
  211.                         CreateResource := suppressErr;
  212.                         exit(CreateResource);
  213.                     end;
  214.             end;
  215. {CreateResource := CreateLevelFromMap(fCells, h, name, fMapList.fVersion.encounter < 3);}
  216.         CreateResource := CreateLevelFromMap(fCells, h, name, true);
  217.     end;
  218.  
  219.     procedure TMap.Changed;
  220.     begin
  221.         fChanged := true;
  222.         fMapList.Changed;
  223.     end;
  224.  
  225.     function TMap.GetCell (cell: Point): MapCell;
  226.     begin
  227.         GetCell := fCells.GetCell(cell);
  228.     end;
  229.  
  230.     procedure TMap.SetCell (cell: Point; code: MapCell);
  231.         var
  232.             item: integer;
  233.             oldCode: MapCell;
  234.     begin
  235.         item := ExtractObject(code);
  236.         if (item >= $13) & (item <= $16) then begin
  237.                 if fStartPosSet then begin
  238.                         oldCode := fCells.GetCell(fStartPos);
  239.                         InsertObject(oldCode, 0);
  240.                         fCells.SetCell(fStartPos, oldCode);
  241.                     end;
  242.                 fStartPos := cell;
  243.                 fStartPosSet := true;
  244.             end
  245.         else if fStartPosSet & EqualPt(cell, fStartPos) then
  246.             fStartPosSet := false;
  247.         fCells.SetCell(cell, code);
  248.     end;
  249.  
  250.     function TMap.GetRowCol (row, col: integer): MapCell;
  251.         var
  252.             cell: Point;
  253.     begin
  254.         cell.v := row;
  255.         cell.h := col;
  256.         GetRowCol := fCells.GetCell(cell);
  257.     end;
  258.  
  259.     procedure TMap.SetRowCol (row, col: integer; code: MapCell);
  260.         var
  261.             cell: Point;
  262.     begin
  263.         cell.v := row;
  264.         cell.h := col;
  265.         fCells.SetCell(cell, code);
  266.     end;
  267.  
  268.     procedure TMap.CopyFrom (src: TMapCells);
  269.         var
  270.             r: Rect;
  271.             cell: Point;
  272.             row, col: integer;
  273.     begin
  274.         src.GetBounds(r);
  275.         for row := r.top to r.bottom - 1 do begin
  276.                 cell.v := row;
  277.                 for col := r.left to r.right - 1 do begin
  278.                         cell.h := col;
  279.                         SetCell(cell, src.GetCell(cell));
  280.                     end;
  281.             end;
  282.     end;
  283.  
  284.     procedure TMap.CopyTo (dst: TMapCells);
  285.         var
  286.             r: Rect;
  287.             cell: Point;
  288.             row, col: integer;
  289.     begin
  290.         dst.GetBounds(r);
  291.         for row := r.top to r.bottom - 1 do begin
  292.                 cell.v := row;
  293.                 for col := r.left to r.right - 1 do begin
  294.                         cell.h := col;
  295.                         dst.SetCell(cell, GetCell(cell));
  296.                     end;
  297.             end;
  298.     end;
  299.  
  300. end.